---
title: "Caracterización Hidroquímica"
author: "Desarrolladores: A.Otiniano & J.Andrade - Expositor:M.Ccopa"
output:
flexdashboard::flex_dashboard:
orientation: columns
theme: lumen
source_code: embed
html_document:
df_print: paged
---
```{r setup, include=FALSE}
knitr::opts_chunk$set(echo = FALSE, message = FALSE, warning = FALSE)
library(readxl);library(flexdashboard) ; library(crosstalk) ; library(tidyverse) ; library(plotly); library(sf); library(mapview); library(DT); library(readxl); library(tmap); library(linemap); library(rgdal);library(leaflet.extras); library(crosstable);
library(psych); library(data.table); library(leaflet.providers); library(leafem)
library(leafsync)
Sys.setenv('MAPBOX_TOKEN' = 'pk.eyJ1IjoiYWxvbnNvMjUiLCJhIjoiY2tveGJseXJpMGNmcDJ3cDhicmZwYmY3MiJ9.SbThU_R8YGE1Zll-nNrZKA')
```
```{r}
Cusco <- read_xlsx(path="BD/BD_Cusco.xlsx", col_names = TRUE)
data01<-Cusco[ ,c("NORTE","ESTE")]
data01<-data01[ ,order(c(names(data01)))]
sputm <- SpatialPoints(data01, proj4string=CRS("+proj=utm +zone=19 +south +datum=WGS84"))
spgeo <- spTransform(sputm, CRS("+proj=longlat +datum=WGS84"))
spgeo <- as.data.frame(spgeo)
colnames(spgeo)<-c("long","lat")
Cusco<-cbind(Cusco,spgeo)
Cusco$CODIGO <- as.factor(Cusco$CODIGO)
Cusco$NOMBRE_FUENTE <- as.factor(Cusco$NOMBRE_FUENTE)
Cusco$DISTRITO <- as.factor(Cusco$DISTRITO)
Cusco$TIPO_FUENTE <- as.factor(Cusco$TIPO_FUENTE)
Cusco$USO_FUENTE <- as.factor(Cusco$USO_FUENTE)
Cusco$Lito1 <- as.factor(Cusco$Lito1)
Cusco$Lito2 <- as.factor(Cusco$Lito2)
Cusco$Lito3 <- as.factor(Cusco$Lito3)
Cusco$COLOR <- as.factor(Cusco$COLOR)
Cusco$OLOR <- as.factor(Cusco$OLOR)
Cusco$FLUJO <- as.factor(Cusco$FLUJO)
Cusco$HIDROTIPO <- as.factor(Cusco$HIDROTIPO)
Cusco$SIMBOLO <- as.factor(Cusco$SIMBOLO)
Cusco$RANGO_DUREZA <- as.factor(Cusco$RANGO_DUREZA)
```
Estadísticas Básicas
=======================================================================
Column {.tabset}
-------------------------------------
### Sumario General I
```{r}
Cusco_fq <- Cusco %>% select("CODIGO","NOMBRE_FUENTE","COTA","Lito1",
"USO_FUENTE","TEMPERATURA","pH","CE",
"TDS", "Salinidad","Resistividad",
"RDO","OD",
"HIDROTIPO","FLUJO",
"long", "lat")
summary(Cusco_fq[ ,1:13])
```
### Sumario General II
```{r}
summary(Cusco_fq[ ,14:ncol(Cusco_fq)])
```
### Sumario de Parámetros Físico-Químicos
```{r}
estadisticos <- function(col){
norm_test <- shapiro.test(col)
value <- c(round(length(col),3),round(sum(is.na(col))),round(min(col,na.rm=TRUE),3),
round(max(col,na.rm=TRUE),3),
round(quantile(col, 0.05,na.rm=TRUE),3),
round(quantile(col, 0.25,na.rm=TRUE),3), round(mean(col,na.rm=TRUE),3), round(median(col,na.rm=TRUE),3),
round(mean(col,trim = 0.10,na.rm=TRUE),3),
round(quantile(col, 0.75,na.rm=TRUE),3),
round(quantile(col, 0.95,na.rm=TRUE),3),
round(IQR(col,na.rm=TRUE),3),
round(mad(col,na.rm=TRUE),3),
round(sd(col,na.rm=TRUE),3),round(skew(col,na.rm=TRUE),3), round(kurtosi(col,na.rm=TRUE),3),
round((sd(col,na.rm=TRUE)/mean(col,na.rm=TRUE))*100,3),
norm_test$statistic, norm_test$p.value)
}
statistic <- c("N","Nulos","Minimo", "Maximo","P5 (5%)","Q1 (25%)","Media Aritmetica","Mediana",
"Trimmed mean (10%)","Q3 (75%)","P95 (95%)", "RIQ","MAD","Sd","As","K","CV",
"Shapiro statistic", "Shapiro p-valor")
T2PRO <- sapply(Cusco_fq[ ,c("TEMPERATURA","pH","CE",
"TDS", "Salinidad","Resistividad",
"RDO","OD")], estadisticos)
rownames(T2PRO) <- statistic
datatable(T2PRO, filter = "top")
```
### Análisis CE-Hidrotipo
```{r}
Filtro2 <- Cusco %>%
group_by(HIDROTIPO) %>%
summarise(
n = n(),
min.ce = round(min(CE, na.rm = FALSE),1),
mean.ce = round(mean(CE, na.rm = FALSE), 1),
ce.50 = quantile(CE, probs = 0.50, na.rm =FALSE),
ce.75 = quantile(CE, probs = 0.75, na.rm =FALSE),
max.ce = max(CE, na.rm = FALSE)
) %>%
arrange(desc(min.ce))
datatable(Filtro2, filter = "top")
```
### Análisis CE-Composición
```{r}
Filtro3 <- Cusco %>%
group_by(Lito1) %>%
summarise(
n = n(),
min.ce = round(min(CE, na.rm = FALSE),1),
mean.ce = round(mean(CE, na.rm = FALSE), 1),
ce.50 = quantile(CE, probs = 0.50, na.rm =FALSE),
ce.75 = quantile(CE, probs = 0.75, na.rm =FALSE),
max.ce = max(CE, na.rm = FALSE)
) %>%
arrange(desc(min.ce))
datatable(Filtro3, filter = "top")
```
### Análisis CE-Composición-Hidrotipo
```{r}
Filtro4 <- Cusco %>%
group_by(Lito1,HIDROTIPO) %>%
summarise(
n = n(),
min.ce = round(min(CE, na.rm = FALSE),1),
mean.ce = round(mean(CE, na.rm = FALSE), 1),
ce.50 = quantile(CE, probs = 0.50, na.rm =FALSE),
ce.75 = quantile(CE, probs = 0.75, na.rm =FALSE),
max.ce = max(CE, na.rm = FALSE)
) %>%
arrange(desc(min.ce))
datatable(Filtro4, filter = "top")
```
Análisis Geoespacial de Parámetros Físico-Químico
=======================================================================
Inputs {.sidebar}
-----------------------------------------------------------------------
```{r}
Cusco_fq$colors <- factor(Cusco_fq$HIDROTIPO, levels = unique(Cusco_fq$HIDROTIPO))
cols <- c(rgb(255,255,0,maxColorValue = 255),
rgb(50,74,178,maxColorValue = 255),
rgb(0,176,242,maxColorValue = 255))
sd <- SharedData$new(Cusco_fq)
```
```{r}
filter_slider("TEMPERATURA", "T(ºC)", sd, ~TEMPERATURA)
filter_slider("pH", "Potencial Hidrógeno", sd, ~pH)
filter_slider("CE", "Conductividad Eléctrica (uS/cm)", sd, ~CE)
filter_slider("TDS", "TDS", sd, ~TDS)
filter_slider("Resistividad", "Resistividad (ohm.m)", sd, ~Resistividad)
filter_select("Lito1", "Composición Geológica", sd, ~Lito1)
```
Column
-------------------------------------
### Geomap Puntos Hidroquímica
```{r}
plot_mapbox(sd, x = ~long, y = ~lat) %>%
add_markers(
split = ~HIDROTIPO, color = ~colors, colors = cols ,
marker = list(size = 15),
text = ~paste(paste("Codigo:", CODIGO), paste("Nombre:", NOMBRE_FUENTE),
paste("Cota(m):", COTA), paste("FLUJO:", FLUJO),
paste("Composicion:", Lito1), paste("HIDROTIPO:", HIDROTIPO),
paste("CE (uS/cm):", CE), sep = "
"),
mode = "scattermapbox", hoverinfo = "text") %>%
layout(title = 'Analisis Hidroquímico',
font = list(color='white'),
plot_bgcolor = '#191A1A', paper_bgcolor = '#191A1A',
legend = list(orientation = 'h',
font = list(size = 8)),
mapbox= list(
style = "mapbox://styles/alonso25/ckppwz4o617pf17pn6iibpsku",
sourcetype = 'vector',
zoom = 9,
showleyend = TRUE,
center = list(lat = ~median(lat), lon = ~median(long)))) %>%
highlight(on = "plotly_selected",off = "plotly_deselect", dynamic = FALSE, color = "red")
```